Home » Source Code » PMCAM2_2.50_Delphi_Source_Code » uUPClickSplitter.pas

uUPClickSplitter.pas ( File view )

  • By sathex 2016-03-20
  • View(s):0
  • Download(s):0
  • Point(s): 1
			unit uUPClickSplitter;
{

 Version 0.6:


}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

const
  cVersion = 'Version 0.7';
  cMinHandledSize = 7;

type
  NaturalNumber = 1..High(Integer);

  TCanResizeEvent = procedure(Sender: TObject; var NewSize: Integer;
    var Accept: Boolean) of object;

  TResizeStyle = (rsNone, rsLine, rsUpdate, rsPattern);
  THandleAlign = (haLeft, haCenter, haRight);
  TClickOrientation = (coLeft, coRight, coUp, coDown);
  TDirection = (diLeft, diRight, diUp, diDown);

  TUPClickSplitter = class(TGraphicControl)
  private
    ctop, cbottom,
    cleft, cright: Integer;
    MouseX, MouseY: Integer;
    bmLeft, bmRight, bmUp, bmDown: TBitmap;
    ctrl1, ctrl2: TControl;
    FOldControlSize: Integer;

    FSplitCursor: TCursor;
    FActiveControl: TWinControl;
    FHandled: Boolean;
    FHandleSize: NaturalNumber;
    FHandleAlign: THandleAlign;
    FBrush: TBrush;
    FControl: TControl;
    FDownPos: TPoint;
    FLineDC: HDC;
    FLineVisible: Boolean;
    FMinSize: NaturalNumber;
    FMaxSize: Integer;
    FNewSize: Integer;
    FOldKeyDown: TKeyEvent;
    FOldSize: Integer;
    FPrevBrush: HBrush;
    FResizeStyle: TResizeStyle;
    FSplit: Integer;

    FOnCanResize: TCanResizeEvent;
    FOnMoved: TNotifyEvent;
    FOnPaint: TNotifyEvent;
    FClickOrientation: TClickOrientation;
    FVersion: string;
    procedure AllocateLineDC;
    procedure CalcSplitSize(X, Y: Integer; var NewSize, Split: Integer);
    procedure DrawLine;
    function FindControl(aDirection: TDirection): TControl;
    procedure FocusKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ReleaseLineDC;
    procedure SetHandled(Value: Boolean);
    procedure UpdateControlSize;
    procedure UpdateSize(X, Y: Integer);
    procedure SetClickOrientation(const Value: TClickOrientation);
    function GetAlign: TAlign;
    procedure SetAlign(const Value: TAlign);
    procedure SetHandleSize(const Value: NaturalNumber);
    procedure SetHandleAlign(const Value: THandleAlign);
    procedure SetVersion(Value: string);
    function GetWidth: Integer;
    procedure SetWidth(const Value: Integer);
    procedure SetHeight(Value: Integer);
    function GetHeight: Integer;
  protected
{
$WARNINGS OFF
}
    function CanResize(var NewSize: Integer): Boolean; {
reintroduce; 
}virtual;
    function DoCanResize(var NewSize: Integer): Boolean; virtual;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;
    procedure RequestAlign;override;
    procedure StopSizing; dynamic;

    function MouseInHandle: Boolean;

    // protected -> no one has to know
    property ClickOrientation: TClickOrientation read FClickOrientation write SetClickOrientation;
    property ResizeStyle: TResizeStyle read FResizeStyle write FResizeStyle default rsPattern;
{
$WARNINGS ON
}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    property Align: TAlign read GetAlign write SetAlign default alLeft;
    property Handled: Boolean read FHandled write SetHandled default True;
    property HandleSize: NaturalNumber read FHandleSize write SetHandleSize default 80;
    property HandleAlign: THandleAlign read FHandleAlign write SetHandleAlign default haCenter;
    property Color;
{
$IFDEF VER120
}
    property Constraints;
{
$ENDIF
}    
    property MinSize: NaturalNumber read FMinSize write FMinSize default 30;
    property ParentColor;
    property Visible;
    property Width: Integer read GetWidth write SetWidth;

    property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize;
    property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property Version: string read FVersion write SetVersion;
    property Height: Integer read GetHeight write SetHeight;
  end;

procedure Register;

implementation

{
$R rUPClickSplitter.res
}
{
$R *.dcr
}

type
  TWinControlAccess = class(TWinControl);

constructor TUPClickSplitter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alLeft;
  Width := 7;
  Cursor := crHSplit;
  FHandled := True;
  FHandleSize := 80;
  FHandleAlign := haCenter;
  FMinSize := 30;
  FResizeStyle := rsPattern;
  FOldSize := -1;
  FVersion := cVersion;

  bmLeft     := TBitmap.Create;
  bmRight    := TBitmap.Create;
  bmUp       := TBitmap.Create;
  bmDown     := TBitmap.Create;

  bmLeft.LoadFromResourceName(HInstance, 'UPCLICK_LEFT');
  bmRight.LoadFromResourceName(HInstance, 'UPCLICK_RIGHT');
  bmUp.LoadFromResourceName(HInstance, 'UPCLICK_UP');
  bmDown.LoadFromResourceName(HInstance, 'UPCLICK_DOWN');
end;

destructor TUPClickSplitter.Destroy;
begin
  FBrush.Free;
  bmLeft.Free;
  bmRight.Free;
  bmUp.Free;
  bmDown.Free;
  inherited Destroy;
end;

procedure TUPClickSplitter.AllocateLineDC;
begin
  FLineDC := GetDCEx(Parent.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS
    or DCX_LOCKWINDOWUPDATE);
  {
if ResizeStyle = rsPattern then
  begin
    if FBrush = nil then
    begin
      FBrush := TBrush.Create;
     // FBrush.Bitmap := AllocPatternBitmap(clBlack, clWhite);
    end;
    FPrevBrush := SelectObject(FLineDC, FBrush.Handle);
  end;
}
end;

procedure TUPClickSplitter.DrawLine;
var
  P: TPoint;
begin
  FLineVisible := not FLineVisible;
  P := Point(Left, Top);
  if Align in [alLeft, alRight] then
    P.X := Left + FSplit else
    P.Y := Top + FSplit;
  with P do PatBlt(FLineDC, X, Y, Width, Height, PATINVERT);
end;

procedure TUPClickSplitter.ReleaseLineDC;
begin
  if FPrevBrush <> 0 then
    SelectObject(FLineDC, FPrevBrush);
  ReleaseDC(Parent.Handle, FLineDC);
  if FBrush <> nil then
  begin
    FBrush.Free;
    FBrush := nil;
  end;
end;

function TUPClickSplitter.FindControl(aDirection: TDirection): TControl;
var
  P: TPoint;
  I: Integer;
  R: TRect;
begin
//  Result := nil;
  P := Point(Left, Top);
  case aDirection of
    diLeft   : Dec(p.x);
    diRight  : Inc(p.x, Width);
    diUp     : Dec(p.y);
    diDown   : Inc(p.y, Height);
  end;
{
  case Align of
    alLeft: Dec(P.X);
    alRight: Inc(P.X, Width);
    alTop: Dec(P.Y);
    alBottom: Inc(P.Y, Height);
  else
    Exit;
  end;
}
  for I := 0 to Parent.ControlCount - 1 do
  begin
    Result := Parent.Controls[I];
    if Result.Visible and Result.Enabled then
    begin
      R := Result.BoundsRect;
      if (R.Right - R.Left) = 0 then
        if Align in [alTop, alLeft] then
          Dec(R.Left)
        else
          Inc(R.Right);
      if (R.Bottom - R.Top) = 0 then
        if Align in [alTop, alLeft] then
          Dec(R.Top)
        else
          Inc(R.Bottom);
      if PtInRect(R, P) then Exit;
    end;
  end;
  Result := nil;
end;

procedure TUPClickSplitter.RequestAlign;
begin
  if (Cursor <> crVSplit) and (Cursor <> crHSplit) then Exit;
  if Align in [alBottom, alTop] then
    Cursor := crVSplit
  else
    Cursor := crHSplit;
end;

procedure TUPClickSplitter.Paint;
const
  XorColor = $00FFD8CE;
var
  R: TRect;
  bm: TBitmap;
begin
  R := ClientRect;
  with Canvas
  do begin
       Pen.Color := Color;
       Pen.Style := psSolid;
       Brush.Color := Color;
       Pen.Mode := pmCopy;
       FillRect(ClientRect);
       Pen.Color := clBtnShadow;
     end;

  if Align in [alLeft, alRight]
  then begin
         case HandleAlign of
           haLeft   : begin
                        ctop := 2;
                        cbottom := ctop + HandleSize;
                      end;
           haCenter : begin
                        ctop := (Height div 2) - (HandleSize div 2);
                        cbottom := ctop + HandleSize;
                      end;
           haRight  : begin
                        ctop := Height - HandleSize - 2;
                        cbottom := ctop + HandleSize;
                      end;
         end;
       end
  else begin
         case HandleAlign of
           haLeft   : begin
                        cleft := 2;
                        cright := cleft + HandleSize;
                      end;
           haCenter : begin
                        cleft := (Width div 2) - (HandleSize div 2);
                        cright := cleft + HandleSize;
                      end;
           haRight  : begin
                        cleft := Width - HandleSize - 2;
                        cright := cleft + HandleSize;
                      end;
         end;
       end;

  if Handled
  then case ClickOrientation of
         coUp,
         coDown  : begin
                     with Canvas
                     do begin
                          Polygon([Point(cright - 1, 0), Point(cleft, 0),
                                   Point(cleft, Height - 1), Point(cright - 1, Height - 1),
                                   Point(cright - 1, 0)]);
                          Pen.Color := clBtnHighlight;
                          PolyLine([Point(cleft + 1, Height - 2), Point(cleft + 1, 1), Point(cright - 1, 1)]);

                          // driehoekjes
                          if ClickOrientation = coUp
                          then bm := bmUp
                          else bm := bmDown;
                          Draw(cleft + 4, 2, bm);
                          Draw(cright - bm.Width - 4, 2, bm);
                        end;
                   end;
         coLeft,
         coRight : begin
                     with Canvas
                     do begin
                          PolyLine([Point(0, cbottom - 1), Point(0, ctop), Point(Width - 1, ctop),
                                    Point(Width - 1, cbottom - 1), Point(0, cbottom - 1)]);
                          Pen.Color := clBtnHighlight;
      
...
...
(Not finished, please download and read the complete file)
			
...
Expand> <Close

Want complete source code? Download it here

Point(s): 1

Download
0 lines left, continue to read
Sponsored links

File list

Tips: You can preview the content of files by clicking file names^_^
Name Size Date
About.rtf20.49 kB2005-03-15|17:16
changelog.txt4.26 kB2005-03-15|17:16
clean.bat92.00 B2005-01-05|02:35
DVBCore.pas31.98 kB2004-12-17|23:45
frmPPVInfo.dfm15.69 kB2004-12-19|19:54
frmPPVInfo.pas6.17 kB2005-03-03|01:02
01.96 kB
About.bmp3.05 kB2004-12-17|23:52
About.ico2.40 kB2004-12-17|23:52
Add.bmp1.30 kB2004-12-17|23:52
bluenote.ico7.23 kB2004-12-17|23:52
bug.jpg6.04 kB2005-01-05|02:35
CAM.ico2.40 kB2004-12-17|23:52
Close.bmp3.05 kB2004-12-17|23:52
EPG.bmp1.05 kB2005-01-05|21:10
EPG.ico1.37 kB2004-12-17|23:52
EPGOFF.bmp1.62 kB2004-12-17|23:52
EPGON.bmp1.62 kB2004-12-17|23:52
EPG_Gliph.bmp3.43 kB2004-12-17|23:52
Event.ico1.37 kB2004-12-17|23:52
jetons.ico1.37 kB2004-12-17|23:52
leftLogo.bmp9.96 kB2004-12-17|23:52
logger.ico1.68 kB2004-12-17|23:52
MagicWand.bmp1.30 kB2004-12-17|23:52
MagicWand.ico1.37 kB2004-12-17|23:52
MAS.ico1.37 kB2004-12-17|23:52
MENOS.ico1.37 kB2004-12-17|23:52
nemesis.ico4.19 kB2004-12-17|23:52
Phoenix.ico1.72 kB2004-12-17|23:52
Provider.ico1.37 kB2004-12-17|23:52
Remove.bmp1.30 kB2004-12-17|23:52
Reset.bmp3.05 kB2004-12-17|23:52
Restart.bmp1.30 kB2004-12-17|23:52
Save.bmp2.05 kB2004-12-17|23:52
scriptengine.ico7.23 kB2004-12-17|23:52
ScriptsEngine.bmp6.80 kB2004-12-17|23:52
Tools.bmp246.00 B2004-12-17|23:52
tuxprogramming.jpg4.15 kB2005-01-13|19:01
V9Card.jpg11.00 kB2005-03-03|01:02
IFSI_IniFiles.pas10.45 kB2004-12-19|19:54
MpgLib.DLL141.50 kB2004-12-24|17:03
PMCAM0.00 B2005-03-15|17:18
PMCAM4.67 kB2005-01-05|17:24
PMCAM4.69 kB2005-01-05|17:24
PMCAM4.52 kB2005-01-05|17:24
PMCAM.rc3.60 kB2004-12-17|23:47
PMCAM2.dpr6.30 kB2005-03-11|20:15
PMCAM2.res1.70 kB2005-03-15|17:16
PMCAM2StandAlone.dpr1.19 kB2005-03-03|01:02
PMCAM2StandAlone.res4.95 kB2005-03-11|20:15
PMCAMMenu.rc259.00 B2004-12-26|20:10
PMCAMMenu.RES162.25 kB2005-03-15|17:16
rUPClickSplitter.res740.00 B2004-12-19|19:54
santa_rock.jpg5.65 kB2004-12-24|17:59
UBitManager.pas4.18 kB2004-12-17|23:45
uDecode123.pas4.01 kB2004-12-29|01:33
UDVBConditionalAccessSystemNames.pas1.49 kB2004-12-17|23:45
UDVBCoreToMD.pas4.59 kB2004-12-17|23:45
UDVBPIDNames.pas1.23 kB2004-12-17|23:45
UDVBTablesHolder.pas2.68 kB2004-12-28|02:17
UEPGEntry.pas3.29 kB2004-12-17|23:45
UEPGMHW.dfm7.72 kB2005-01-11|02:38
UEPGMHW.pas40.85 kB2005-01-11|02:38
UfrmAddFilter.dfm6.86 kB2004-12-17|23:46
UfrmAddFilter.pas3.68 kB2004-12-17|23:45
UfrmCAM.dfm217.00 kB2005-03-15|03:22
UfrmCAM.pas159.37 kB2005-03-15|17:16
ufrmDLLForm.dfm420.00 B2004-12-19|19:54
ufrmDLLForm.pas1.87 kB2004-12-26|20:10
UfrmEMM.dfm1.28 kB2004-12-17|23:46
UfrmEMM.pas1.47 kB2004-12-17|23:45
UfrmEPGAdvanced.dfm7.01 kB2005-01-05|21:10
UfrmEPGAdvanced.pas2.56 kB2005-01-05|21:10
UfrmMHWEPGEntries.dfm3.81 kB2004-12-17|23:46
UfrmMHWEPGEntries.pas4.33 kB2004-12-17|23:45
ufrmMHWRadio.dfm35.85 kB2005-01-21|18:53
ufrmMHWRadio.pas37.84 kB2005-01-21|18:53
UfrmPMTDetails.dfm2.31 kB2005-01-21|18:53
UfrmPMTDetails.pas2.74 kB2005-01-21|18:53
UfrmWarningOnExit.dfm15.64 kB2005-01-05|21:10
UfrmWarningOnExit.pas1.44 kB2005-01-05|21:10
ULogEngine.pas15.89 kB2005-03-12|17:11
UMDDefs.pas4.07 kB2005-03-03|01:02
UMD_Impl.pas11.26 kB2005-03-03|01:02
United32.pas14.20 kB2004-12-17|23:45
UnitISO639_3.pas10.04 kB2005-03-03|01:02
UnitMDInterface.pas28.92 kB2005-03-15|03:22
UnitTimer.pas1.39 kB2004-12-17|23:45
Unit_CRC32.pas3.62 kB2004-12-17|23:45
uPESToTS.pas6.11 kB2005-03-03|01:02
UScriptFunctions.pas2.97 kB2005-01-03|16:45
UScriptsEditor.dfm58.10 kB2005-01-21|18:53
UScriptsEditor.pas22.02 kB2005-03-03|01:02
USECAManager.pas18.26 kB2005-03-03|01:02
USECATableStore.pas12.92 kB2004-12-17|23:45
USECA_EMM.pas7.74 kB2005-03-12|03:36
USmartCardISO.pas14.45 kB2004-12-17|23:45
UTfrmMultiDec.dfm407.00 B2005-01-21|18:53
UTfrmMultiDec.pas4.38 kB2005-01-21|18:53
UTranslate.pas6.49 kB2004-12-24|17:03
UTS184ToBitFilter.pas36.28 kB2005-03-11|20:15
uUPClickSplitter.dcr488.00 B2004-12-19|19:54
uUPClickSplitter.dcu18.09 kB2005-03-03|01:02
uUPClickSplitter.pas20.43 kB2004-12-26|20:10
PMCAM2_2.50.zip870.87 kB2016-03-19|22:08
...
Sponsored links

uUPClickSplitter.pas (1.30 MB)

Need 1 point
Your Point(s)

Your Point isn't enough.

Get point immediately by PayPal

More(Debit card / Credit card / PayPal Credit / Online Banking)

Submit your source codes. Get more point

LOGIN

Don't have an account? Register now
Need any help?
Mail to: support@codeforge.com

切换到中文版?

CodeForge Chinese Version
CodeForge English Version

Where are you going?

^_^"Oops ...

Sorry!This guy is mysterious, its blog hasn't been opened, try another, please!
OK

Warm tip!

CodeForge to FavoriteFavorite by Ctrl+D