Changeset 14 for trunk


Ignore:
Timestamp:
Jan 7, 2017, 8:54:23 PM (8 years ago)
Author:
chronos
Message:
  • Removed: Do not create file association at runtime as it is done by installer program.
  • Modified: Additional source formating using Delphi formatter.
Location:
trunk
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/Components/ButtonA.pas

    r10 r14  
    3030procedure Register;
    3131begin
    32 RegisterComponents('Samples', [TButtonA]);
     32  RegisterComponents('Samples', [TButtonA]);
    3333end;
    3434
    3535constructor TButtonA.Create(aOwner: TComponent);
    3636begin
    37 inherited Create(aOwner);
    38 FCaption:='';
    39 SetBounds(0,0,100,25);
     37  inherited Create(aOwner);
     38  FCaption := '';
     39  SetBounds(0, 0, 100, 25);
    4040end;
    4141
    4242procedure TButtonA.Paint;
    4343begin
    44 with Canvas do
    45   if FGraphic<>nil then
     44  with Canvas do
     45    if FGraphic <> nil then
    4646    begin
    47     BitBlt(Canvas.Handle,0,0,100,25,Graphic.Canvas.Handle,
    48       195,243+26*Byte(Down),SRCCOPY);
    49     Canvas.Brush.Style:=bsClear;
    50     Textout(50-(TextWidth(FCaption)+1) div 2,12-textheight(FCaption) div 2,
    51       FCaption);
     47      BitBlt(Canvas.Handle, 0, 0, 100, 25, Graphic.Canvas.Handle, 195,
     48        243 + 26 * Byte(Down), SRCCOPY);
     49      Canvas.Brush.Style := bsClear;
     50      Textout(50 - (TextWidth(FCaption) + 1) div 2, 12 - textheight(FCaption)
     51        div 2, FCaption);
    5252    end
    53   else begin Brush.Color:=$0000FF; FrameRect(Rect(0,0,100,25)) end
     53    else
     54    begin
     55      Brush.Color := $0000FF;
     56      FrameRect(Rect(0, 0, 100, 25))
     57    end
    5458end;
    5559
    5660procedure TButtonA.SetCaption(x: string);
    5761begin
    58 if x<>FCaption then
     62  if x <> FCaption then
    5963  begin
    60   FCaption:=x;
    61   Invalidate
     64    FCaption := x;
     65    Invalidate
    6266  end
    6367end;
    … …  
    6569procedure TButtonA.SetFont(const x: TFont);
    6670begin
    67 Canvas.Font.Assign(x);
    68 Canvas.Font.Color:=$000000;
     71  Canvas.Font.Assign(x);
     72  Canvas.Font.Color := $000000;
    6973end;
    7074
    7175end.
    72 

  • trunk/Components/ButtonB.pas

    r10 r14  
    3030procedure Register;
    3131begin
    32 RegisterComponents('Samples', [TButtonB]);
     32  RegisterComponents('Samples', [TButtonB]);
    3333end;
    3434
    3535constructor TButtonB.Create(aOwner: TComponent);
    3636begin
    37 inherited Create(aOwner);
    38 ShowHint:=true;
    39 SetBounds(0,0,25,25);
     37  inherited Create(aOwner);
     38  ShowHint := true;
     39  SetBounds(0, 0, 25, 25);
    4040end;
    4141
    4242procedure TButtonB.Paint;
    4343begin
    44 with Canvas do
    45   if FGraphic<>nil then
     44  with Canvas do
     45    if FGraphic <> nil then
    4646    begin
    47     BitBlt(Canvas.Handle,0,0,25,25,FGraphic.Canvas.Handle,
    48       169,243+26*Byte(FDown),SRCCOPY);
    49     if FIndex>=0 then
     47      BitBlt(Canvas.Handle, 0, 0, 25, 25, FGraphic.Canvas.Handle, 169,
     48        243 + 26 * Byte(FDown), SRCCOPY);
     49      if FIndex >= 0 then
    5050      begin
    51       BitBlt(Canvas.Handle,0,0,25,25,FMask.Canvas.Handle,
    52         1+FIndex mod 12 *26,337+FIndex div 12 *26,SRCAND);
    53       BitBlt(Canvas.Handle,0,0,25,25,FGraphic.Canvas.Handle,
    54         1+FIndex mod 12 *26,337+FIndex div 12 *26,SRCPAINT);
     51        BitBlt(Canvas.Handle, 0, 0, 25, 25, FMask.Canvas.Handle,
     52          1 + FIndex mod 12 * 26, 337 + FIndex div 12 * 26, SRCAND);
     53        BitBlt(Canvas.Handle, 0, 0, 25, 25, FGraphic.Canvas.Handle,
     54          1 + FIndex mod 12 * 26, 337 + FIndex div 12 * 26, SRCPAINT);
    5555      end
    5656    end
    57   else begin Brush.Color:=$0000FF; FrameRect(Rect(0,0,25,25)) end
     57    else
     58    begin
     59      Brush.Color := $0000FF;
     60      FrameRect(Rect(0, 0, 25, 25))
     61    end
    5862end;
    5963
    6064procedure TButtonB.SetIndex(x: integer);
    6165begin
    62 if x<>FIndex then
     66  if x <> FIndex then
    6367  begin
    64   FIndex:=x;
    65   Invalidate
     68    FIndex := x;
     69    Invalidate
    6670  end
    6771end;
    6872
    6973end.
    70 

  • trunk/Components/ButtonBase.pas

    r10 r14  
    1010    constructor Create(aOwner: TComponent); override;
    1111  protected
    12     FDown,FPermanent: boolean;
     12    FDown, FPermanent: boolean;
    1313    FGraphic: TBitmap;
    14 //    FDownSound, FUpSound: string;
     14    // FDownSound, FUpSound: string;
    1515    ClickProc: TNotifyEvent;
    1616    DownChangedProc: TNotifyEvent;
    1717    procedure SetDown(x: boolean);
    18 //    procedure PlayDownSound;
    19 //    procedure PlayUpSound;
     18    // procedure PlayDownSound;
     19    // procedure PlayUpSound;
    2020    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
    2121      x, y: integer); override;
    … …  
    2727  public
    2828    property Graphic: TBitmap read FGraphic write FGraphic;
    29 //    property DownSound: string read FDownSound write FDownSound;
    30 //    property UpSound: string read FUpSound write FUpSound;
     29    // property DownSound: string read FDownSound write FDownSound;
     30    // property UpSound: string read FUpSound write FUpSound;
    3131  published
    3232    property Visible;
    … …  
    3434    property Permanent: boolean read FPermanent write FPermanent;
    3535    property OnClick: TNotifyEvent read ClickProc write ClickProc;
    36     property OnDownChanged: TNotifyEvent read DownChangedProc write DownChangedProc;
     36    property OnDownChanged: TNotifyEvent read DownChangedProc
     37      write DownChangedProc;
    3738  end;
    3839
    3940implementation
    4041
    41 //uses
    42 //  MMSystem;
     42// uses
     43// MMSystem;
    4344
    44 constructor TButtonBase.Create(AOwner: TComponent);
     45constructor TButtonBase.Create(aOwner: TComponent);
    4546begin
    4647  inherited;
    47   //FDownSound:='';
    48   //FUpSound:='';
    49   FGraphic:=nil; Active:=false; FDown:=false; FPermanent:=false;
    50   ClickProc:=nil;
     48  // FDownSound:='';
     49  // FUpSound:='';
     50  FGraphic := nil;
     51  Active := false;
     52  FDown := false;
     53  FPermanent := false;
     54  ClickProc := nil;
    5155end;
    5256
    5357procedure TButtonBase.MouseDown(Button: TMouseButton; Shift: TShiftState;
    54       x, y: integer);
     58  x, y: integer);
    5559begin
    56   Active:=true;
    57   MouseMove(Shift,x,y)
     60  Active := true;
     61  MouseMove(Shift, x, y)
    5862end;
    5963
    6064procedure TButtonBase.MouseUp(Button: TMouseButton; Shift: TShiftState;
    61       x, y: integer);
     65  x, y: integer);
    6266begin
    63   if ssLeft in Shift then exit;
    64     MouseMove(Shift,x,y);
     67  if ssLeft in Shift then
     68    exit;
     69  MouseMove(Shift, x, y);
    6570  if Active and FDown then
    6671  begin
    67 // PlayUpSound;
    68   Active:=false;
    69   if FDown<>FPermanent then
     72    // PlayUpSound;
     73    Active := false;
     74    if FDown <> FPermanent then
    7075    begin
    71     FDown:=FPermanent;
    72     Invalidate;
    73     if @DownChangedProc<>nil then DownChangedProc(self);
     76      FDown := FPermanent;
     77      Invalidate;
     78      if @DownChangedProc <> nil then
     79        DownChangedProc(self);
    7480    end;
    75   if (Button=mbLeft) and (@ClickProc<>nil) then ClickProc(self)
     81    if (Button = mbLeft) and (@ClickProc <> nil) then
     82      ClickProc(self)
    7683  end
    77 else
     84  else
    7885  begin
    79 // if FDown then PlayUpSound;
    80   Active:=false;
    81   if FDown then
     86    // if FDown then PlayUpSound;
     87    Active := false;
     88    if FDown then
    8289    begin
    83     FDown:=false;
    84     Invalidate;
    85     if @DownChangedProc<>nil then DownChangedProc(self);
     90      FDown := false;
     91      Invalidate;
     92      if @DownChangedProc <> nil then
     93        DownChangedProc(self);
    8694    end;
    8795  end
    … …  
    9098procedure TButtonBase.MouseMove(Shift: TShiftState; x, y: integer);
    9199begin
    92 if Active then
    93    if (x>=0) and (x<Width) and (y>=0) and (y<Height) then
    94      if (ssLeft in Shift) and not FDown then
    95        begin
    96        {PlayDownSound;}
    97        FDown:=true;
    98        Paint;
    99        if @DownChangedProc<>nil then DownChangedProc(self);
    100        end
    101    else else if FDown and not FPermanent then
    102      begin
    103      {PlayUpSound;}
    104      FDown:=false;
    105      Paint;
    106      if @DownChangedProc<>nil then DownChangedProc(self);
    107      end
     100  if Active then
     101    if (x >= 0) and (x < Width) and (y >= 0) and (y < Height) then
     102      if (ssLeft in Shift) and not FDown then
     103      begin
     104        { PlayDownSound; }
     105        FDown := true;
     106        Paint;
     107        if @DownChangedProc <> nil then
     108          DownChangedProc(self);
     109      end
     110      else
     111    else if FDown and not FPermanent then
     112    begin
     113      { PlayUpSound; }
     114      FDown := false;
     115      Paint;
     116      if @DownChangedProc <> nil then
     117        DownChangedProc(self);
     118    end
    108119end;
    109120
    110121procedure TButtonBase.SetDown(x: boolean);
    111122begin
    112 FDown:=x;
    113 Invalidate
     123  FDown := x;
     124  Invalidate
    114125end;
    115126
    116 //procedure TButtonBase.PlayDownSound;
    117 //begin
    118 //if DownSound<>'' then SndPlaySound(pchar(DownSound),SND_ASYNC)
    119 //end;
     127// procedure TButtonBase.PlayDownSound;
     128// begin
     129// if DownSound<>'' then SndPlaySound(pchar(DownSound),SND_ASYNC)
     130// end;
    120131
    121 //procedure TButtonBase.PlayUpSound;
    122 //begin
    123 //if UpSound<>'' then SndPlaySound(pchar(UpSound),SND_ASYNC)
    124 //end;
     132// procedure TButtonBase.PlayUpSound;
     133// begin
     134// if UpSound<>'' then SndPlaySound(pchar(UpSound),SND_ASYNC)
     135// end;
    125136
    126137end.
    127 

  • trunk/Components/ButtonC.pas

    r10 r14  
    2727procedure Register;
    2828begin
    29 RegisterComponents('Samples', [TButtonC]);
     29  RegisterComponents('Samples', [TButtonC]);
    3030end;
    3131
    3232constructor TButtonC.Create(aOwner: TComponent);
    3333begin
    34 inherited Create(aOwner);
    35 ShowHint:=true;
    36 SetBounds(0,0,12,12);
     34  inherited Create(aOwner);
     35  ShowHint := true;
     36  SetBounds(0, 0, 12, 12);
    3737end;
    3838
    3939procedure TButtonC.Paint;
    4040begin
    41 with Canvas do
    42   if FGraphic<>nil then
    43     BitBlt(Canvas.Handle,0,0,12,12,FGraphic.Canvas.Handle,
    44       169+13*Byte(FDown),159+13*FIndex,SRCCOPY)
    45   else begin Brush.Color:=$0000FF; FrameRect(Rect(0,0,12,12)) end
     41  with Canvas do
     42    if FGraphic <> nil then
     43      BitBlt(Canvas.Handle, 0, 0, 12, 12, FGraphic.Canvas.Handle,
     44        169 + 13 * Byte(FDown), 159 + 13 * FIndex, SRCCOPY)
     45    else
     46    begin
     47      Brush.Color := $0000FF;
     48      FrameRect(Rect(0, 0, 12, 12))
     49    end
    4650end;
    4751
    4852procedure TButtonC.SetIndex(x: integer);
    4953begin
    50 if x<>FIndex then
     54  if x <> FIndex then
    5155  begin
    52   FIndex:=x;
    53   Invalidate
     56    FIndex := x;
     57    Invalidate
    5458  end
    5559end;
    5660
    5761end.
    58 

  • trunk/Components/ButtonN.pas

    r10 r14  
    1212    FPossible, FLit: boolean;
    1313    FGraphic, FMask, FBackGraphic: TBitmap;
    14     FIndex,BackIndex: integer;
     14    FIndex, BackIndex: integer;
    1515    FSmartHint: string;
    1616    ChangeProc: TNotifyEvent;
    … …  
    4040procedure Register;
    4141begin
    42 RegisterComponents('Samples', [TButtonN]);
     42  RegisterComponents('Samples', [TButtonN]);
    4343end;
    4444
    4545constructor TButtonN.Create(aOwner: TComponent);
    4646begin
    47 inherited Create(aOwner);
    48 ShowHint:=true;
    49 FGraphic:=nil;
    50 FBackGraphic:=nil;
    51 FPossible:=true;
    52 FLit:=false;
    53 FIndex:=-1;
    54 ChangeProc:=nil;
    55 SetBounds(0,0,42,42);
     47  inherited Create(aOwner);
     48  ShowHint := true;
     49  FGraphic := nil;
     50  FBackGraphic := nil;
     51  FPossible := true;
     52  FLit := false;
     53  FIndex := -1;
     54  ChangeProc := nil;
     55  SetBounds(0, 0, 42, 42);
    5656end;
    5757
    5858procedure TButtonN.Paint;
    5959begin
    60 with Canvas do
     60  with Canvas do
    6161  begin
    62   if FGraphic<>nil then
     62    if FGraphic <> nil then
    6363    begin
    64     BitBlt(Canvas.Handle,1,1,40,40,FBackGraphic.Canvas.Handle,
    65       1+80*BackIndex+40*byte(FPossible and FLit),176,SRCCOPY);
    66     if FPossible then
     64      BitBlt(Canvas.Handle, 1, 1, 40, 40, FBackGraphic.Canvas.Handle,
     65        1 + 80 * BackIndex + 40 * byte(FPossible and FLit), 176, SRCCOPY);
     66      if FPossible then
    6767      begin
    68       BitBlt(Canvas.Handle,3,3,36,36,FMask.Canvas.Handle,
    69         195+37*(FIndex mod 3),21+37*(FIndex div 3),SRCAND);
    70       BitBlt(Canvas.Handle,3,3,36,36,FGraphic.Canvas.Handle,
    71         195+37*(FIndex mod 3),21+37*(FIndex div 3),SRCPAINT);
     68        BitBlt(Canvas.Handle, 3, 3, 36, 36, FMask.Canvas.Handle,
     69          195 + 37 * (FIndex mod 3), 21 + 37 * (FIndex div 3), SRCAND);
     70        BitBlt(Canvas.Handle, 3, 3, 36, 36, FGraphic.Canvas.Handle,
     71          195 + 37 * (FIndex mod 3), 21 + 37 * (FIndex div 3), SRCPAINT);
    7272      end
    7373    end;
    74   MoveTo(0,41);
    75   Pen.Color:=$B0B0B0;LineTo(0,0);LineTo(41,0);
    76   Pen.Color:=$FFFFFF;LineTo(41,41);LineTo(0,41);
     74    MoveTo(0, 41);
     75    Pen.Color := $B0B0B0;
     76    LineTo(0, 0);
     77    LineTo(41, 0);
     78    Pen.Color := $FFFFFF;
     79    LineTo(41, 41);
     80    LineTo(0, 41);
    7781  end
    7882end;
    7983
    8084procedure TButtonN.MouseDown(Button: TMouseButton; Shift: TShiftState;
    81       x, y: integer);
     85  x, y: integer);
    8286begin
    83 if FPossible and (Button=mbLeft) and (@ChangeProc<>nil) then
    84   ChangeProc(Self)
     87  if FPossible and (Button = mbLeft) and (@ChangeProc <> nil) then
     88    ChangeProc(Self)
    8589end;
    8690
    8791procedure TButtonN.SetPossible(x: boolean);
    8892begin
    89 if x<>FPossible then
     93  if x <> FPossible then
    9094  begin
    91   FPossible:=x;
    92   if x then Hint:=FSmartHint
    93   else Hint:='';
    94   Invalidate
     95    FPossible := x;
     96    if x then
     97      Hint := FSmartHint
     98    else
     99      Hint := '';
     100    Invalidate
    95101  end
    96102end;
    … …  
    98104procedure TButtonN.SetLit(x: boolean);
    99105begin
    100 if x<>FLit then
     106  if x <> FLit then
    101107  begin
    102   FLit:=x;
    103   Invalidate
     108    FLit := x;
     109    Invalidate
    104110  end
    105111end;
    … …  
    107113procedure TButtonN.SetIndex(x: integer);
    108114begin
    109 if x<>FIndex then
     115  if x <> FIndex then
    110116  begin
    111   FIndex:=x;
    112   if x<6 then BackIndex:=1
    113   else BackIndex:=0;
    114   Invalidate
     117    FIndex := x;
     118    if x < 6 then
     119      BackIndex := 1
     120    else
     121      BackIndex := 0;
     122    Invalidate
    115123  end
    116124end;
    … …  
    118126procedure TButtonN.SetSmartHint(x: string);
    119127begin
    120 if x<>FSmartHint then
     128  if x <> FSmartHint then
    121129  begin
    122   FSmartHint:=x;
    123   if FPossible then Hint:=x;
     130    FSmartHint := x;
     131    if FPossible then
     132      Hint := x;
    124133  end
    125134end;
    126135
    127136end.
    128 

  • trunk/Components/EOTButton.pas

    r10 r14  
    88
    99const
    10 eotBlinkOff=-1; eotCancel=0; eotGray=1; eotBlinkOn=2; eotBackToNego=3;
     10  eotBlinkOff = -1;
     11  eotCancel = 0;
     12  eotGray = 1;
     13  eotBlinkOn = 2;
     14  eotBackToNego = 3;
    1115
    1216type
    … …  
    1519    destructor Destroy; override;
    1620    procedure SetButtonIndexFast(x: integer);
    17     procedure SetBack(ca: TCanvas; x,y: integer);
     21    procedure SetBack(ca: TCanvas; x, y: integer);
    1822  private
    1923    FTemplate: TBitmap;
    … …  
    3741procedure Register;
    3842begin
    39 RegisterComponents('Samples', [TEOTButton]);
     43  RegisterComponents('Samples', [TEOTButton]);
    4044end;
    4145
    42 procedure ImageOp_CBC(Dst,Src: TBitmap; xDst,yDst,xSrc,ySrc,w,h,Color0,Color2: integer);
     46procedure ImageOp_CBC(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h, Color0,
     47  Color2: integer);
    4348// Src is template
    4449// B channel = Color0 amp
    … …  
    4651// R channel = Color2 amp
    4752type
    48 TLine=array[0..9999,0..2] of Byte;
     53  TLine = array [0 .. 9999, 0 .. 2] of Byte;
    4954var
    50 ix,iy,amp0,amp1,trans,Value: integer;
    51 SrcLine,DstLine: ^TLine;
     55  ix, iy, amp0, amp1, trans, Value: integer;
     56  SrcLine, DstLine: ^TLine;
    5257begin
    53 for iy:=0 to h-1 do
     58  for iy := 0 to h - 1 do
    5459  begin
    55   SrcLine:=Src.ScanLine[ySrc+iy];
    56   DstLine:=Dst.ScanLine[yDst+iy];
    57   for ix:=0 to w-1 do
     60    SrcLine := Src.ScanLine[ySrc + iy];
     61    DstLine := Dst.ScanLine[yDst + iy];
     62    for ix := 0 to w - 1 do
    5863    begin
    59     trans:=SrcLine[xSrc+ix,0]*2; // green channel = transparency
    60     amp0:=SrcLine[xSrc+ix,1]*2;
    61     amp1:=SrcLine[xSrc+ix,2]*2;
    62     if trans<>$FF then
     64      trans := SrcLine[xSrc + ix, 0] * 2; // green channel = transparency
     65      amp0 := SrcLine[xSrc + ix, 1] * 2;
     66      amp1 := SrcLine[xSrc + ix, 2] * 2;
     67      if trans <> $FF then
    6368      begin
    64       Value:=(DstLine[xDst+ix][0]*trans+(Color2 shr 16 and $FF)*amp1+(Color0 shr 16 and $FF)*amp0) div $FF;
    65       if Value<256 then
    66         DstLine[xDst+ix][0]:=Value
    67       else DstLine[xDst+ix][0]:=255;
    68       Value:=(DstLine[xDst+ix][1]*trans+(Color2 shr 8 and $FF)*amp1+(Color0 shr 8 and $FF)*amp0) div $FF;
    69       if Value<256 then
    70         DstLine[xDst+ix][1]:=Value
    71       else DstLine[xDst+ix][1]:=255;
    72       Value:=(DstLine[xDst+ix][2]*trans+(Color2 and $FF)*amp1+(Color0 and $FF)*amp0) div $FF;
    73       if Value<256 then
    74         DstLine[xDst+ix][2]:=Value
    75       else DstLine[xDst+ix][2]:=255;
     69        Value := (DstLine[xDst + ix][0] * trans + (Color2 shr 16 and $FF) * amp1
     70          + (Color0 shr 16 and $FF) * amp0) div $FF;
     71        if Value < 256 then
     72          DstLine[xDst + ix][0] := Value
     73        else
     74          DstLine[xDst + ix][0] := 255;
     75        Value := (DstLine[xDst + ix][1] * trans + (Color2 shr 8 and $FF) * amp1
     76          + (Color0 shr 8 and $FF) * amp0) div $FF;
     77        if Value < 256 then
     78          DstLine[xDst + ix][1] := Value
     79        else
     80          DstLine[xDst + ix][1] := 255;
     81        Value := (DstLine[xDst + ix][2] * trans + (Color2 and $FF) * amp1 +
     82          (Color0 and $FF) * amp0) div $FF;
     83        if Value < 256 then
     84          DstLine[xDst + ix][2] := Value
     85        else
     86          DstLine[xDst + ix][2] := 255;
    7687      end
    7788    end
    … …  
    8192constructor TEOTButton.Create;
    8293begin
    83 inherited Create(aOwner);
    84 Buffer:=TBitmap.Create;
    85 Buffer.PixelFormat:=pf24bit;
    86 Buffer.Width:=48;
    87 Buffer.Height:=48;
    88 Back:=TBitmap.Create;
    89 Back.PixelFormat:=pf24bit;
    90 Back.Width:=48;
    91 Back.Height:=48;
    92 ShowHint:=true;
    93 SetBounds(0,0,48,48);
     94  inherited Create(aOwner);
     95  Buffer := TBitmap.Create;
     96  Buffer.PixelFormat := pf24bit;
     97  Buffer.Width := 48;
     98  Buffer.Height := 48;
     99  Back := TBitmap.Create;
     100  Back.PixelFormat := pf24bit;
     101  Back.Width := 48;
     102  Back.Height := 48;
     103  ShowHint := true;
     104  SetBounds(0, 0, 48, 48);
    94105end;
    95106
    96107destructor TEOTButton.Destroy;
    97108begin
    98 Buffer.Free;
    99 Back.Free;
    100 inherited Destroy;
     109  Buffer.Free;
     110  Back.Free;
     111  inherited Destroy;
    101112end;
    102113
    103114procedure TEOTButton.Paint;
    104115begin
    105 with Canvas do
    106   if FGraphic<>nil then
     116  with Canvas do
     117    if FGraphic <> nil then
    107118    begin
    108     BitBlt(Buffer.Canvas.Handle,0,0,48,48,Back.Canvas.Handle,0,0,SRCCOPY);
    109     ImageOp_CBC(Buffer, Template, 0, 0, 133, 149+48*byte(FDown), 48, 48, $000000, $FFFFFF);
    110     if FIndex>=0 then
    111       ImageOp_CBC(Buffer, Template, 8, 8, 1+32*byte(FIndex), 246, 32, 32, $000000, $FFFFFF);
    112     BitBlt(Canvas.Handle,0,0,48,48,Buffer.Canvas.Handle,0,0,SRCCOPY);
     119      BitBlt(Buffer.Canvas.Handle, 0, 0, 48, 48, Back.Canvas.Handle, 0,
     120        0, SRCCOPY);
     121      ImageOp_CBC(Buffer, Template, 0, 0, 133, 149 + 48 * Byte(FDown), 48, 48,
     122        $000000, $FFFFFF);
     123      if FIndex >= 0 then
     124        ImageOp_CBC(Buffer, Template, 8, 8, 1 + 32 * Byte(FIndex), 246, 32, 32,
     125          $000000, $FFFFFF);
     126      BitBlt(Canvas.Handle, 0, 0, 48, 48, Buffer.Canvas.Handle, 0, 0, SRCCOPY);
    113127    end
    114   else begin Brush.Color:=$0000FF; FrameRect(Rect(0,0,48,48)) end
     128    else
     129    begin
     130      Brush.Color := $0000FF;
     131      FrameRect(Rect(0, 0, 48, 48))
     132    end
    115133end;
    116134
    117135procedure TEOTButton.SetIndex(x: integer);
    118136begin
    119 if x<>FIndex then
     137  if x <> FIndex then
    120138  begin
    121   FIndex:=x;
    122   Invalidate
     139    FIndex := x;
     140    Invalidate
    123141  end
    124142end;
    … …  
    126144procedure TEOTButton.SetButtonIndexFast(x: integer);
    127145begin
    128 if Visible and (x<>FIndex) then
     146  if Visible and (x <> FIndex) then
    129147  begin
    130   FIndex:=x;
    131   try
    132     Paint
    133   except
     148    FIndex := x;
     149    try
     150      Paint
     151    except
    134152    end
    135153  end
    136154end;
    137155
    138 procedure TEOTButton.SetBack(ca: TCanvas; x,y: integer);
     156procedure TEOTButton.SetBack(ca: TCanvas; x, y: integer);
    139157begin
    140 BitBlt(Back.Canvas.Handle,0,0,48,48,ca.Handle,x,y,SRCCOPY);
     158  BitBlt(Back.Canvas.Handle, 0, 0, 48, 48, ca.Handle, x, y, SRCCOPY);
    141159end;
    142160
    143161end.
    144 

  • trunk/Integrated.lpi

    r12 r14  
    2929          <PathDelim Value="\"/>
    3030          <Target>
    31             <Filename Value="C-evo"/>
     31            <Filename Value="c-evo"/>
    3232          </Target>
    3333          <SearchPaths>
    34             <IncludeFiles Value="LocalPlayer"/>
     34            <IncludeFiles Value="LocalPlayer;$(ProjOutDir)"/>
    3535            <OtherUnitFiles Value="LocalPlayer"/>
    3636            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    … …  
    4545          </Parsing>
    4646          <CodeGeneration>
     47            <SmartLinkUnit Value="True"/>
     48            <TargetCPU Value="i386"/>
     49            <TargetOS Value="win32"/>
    4750            <Optimizations>
    4851              <OptimizationLevel Value="3"/>
    … …  
    5356              <GenerateDebugInfo Value="False"/>
    5457            </Debugging>
     58            <LinkSmart Value="True"/>
    5559            <Options>
    5660              <Win32>
    … …  
    290294    </Target>
    291295    <SearchPaths>
    292       <IncludeFiles Value="LocalPlayer;$(ProjOutDir)"/>
     296      <IncludeFiles Value="LocalPlayer"/>
    293297      <OtherUnitFiles Value="LocalPlayer"/>
    294298      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>

  • trunk/ScreenTools.pas

    r11 r14  
    77  Windows, StringTables,
    88
    9   LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus;
     9  LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls,
     10  Forms, Menus;
    1011
    1112type
    … …  
    1617  end;
    1718
    18     function ChangeResolution(x, y, bpp, freq: integer): boolean;
    19     procedure RestoreResolution;
    20     function Play(Item: string; Index: integer = -1): boolean;
    21     procedure PreparePlay(Item: string; Index: integer = -1);
    22     procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0);
    23     function turntoyear(Turn: integer): integer;
    24     function TurnToString(Turn: integer): string;
    25     function MovementToString(Movement: integer): string;
    26     procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
    27     procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
    28     function HexStringToColor(s: string): integer;
    29     function LoadGraphicFile(bmp: TBitmap; Path: string;
    30       Options: integer = 0): boolean;
    31     function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string;
    32       Options: integer = 0): boolean;
    33     function LoadGraphicSet(Name: string): integer;
    34     procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr,
    35       yGr: integer);
    36     procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr,
    37       yGr: integer); overload;
    38     procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr,
    39       yGr: integer); overload;
    40     procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
    41     procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w,
    42       h: integer);
    43     procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h,
    44       Color1, Color2: integer);
    45     procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1,
    46       Color2: integer);
    47     procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
    48     procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
    49     procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    50     procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    51     procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
    52     procedure FrameImage(ca: TCanvas; Src: TBitmap;
    53       x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = false);
    54     procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer;
    55       cl: TColor);
    56     procedure InitOrnament;
    57     procedure InitCityMark(const T: TTexture);
    58     procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset,
    59       yOffset: integer);
    60     procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
    61     procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset,
    62       yOffset: integer; const Texture: TBitmap);
    63     procedure FillRectSeamless(ca: TCanvas;
    64       x0, y0, x1, y1, xOffset, yOffset: integer; const Texture: TBitmap);
    65     procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
    66     procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture);
    67     procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer;
    68       s: string);
    69     procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
    70       x, y: integer; s: string);
    71     function BiColorTextWidth(ca: TCanvas; s: string): integer;
    72     procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
    73     procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
    74     procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
    75     procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
    76     procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
    77     procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;
    78       const T: TTexture);
    79     procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;
    80       Cap: string; val: integer; const T: TTexture);
    81     procedure PaintProgressBar(ca: TCanvas;
    82       Kind, x, y, pos, Growth, max: integer; const T: TTexture);
    83     procedure PaintRelativeProgressBar(ca: TCanvas;
    84       Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;
    85       const T: TTexture);
    86     procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
    87     function SetMainTextureByAge(Age: integer): boolean;
    88 
    89   const
    90     nGrExtmax = 64;
    91     wMainTexture = 640;
    92     hMainTexture = 480;
    93 
    94     // template positions in Template.bmp
    95     xLogo = 1;
    96     yLogo = 1;
    97     wLogo = 122;
    98     hLogo = 23; // logo
    99     xBBook = 1;
    100     yBBook = 74;
    101     wBBook = 143;
    102     hBBook = 73; // big book
    103     xSBook = 72;
    104     ySBook = 37;
    105     wSBook = 72;
    106     hSBook = 36; // small book
    107     xNation = 1;
    108     yNation = 25;
    109     xCoal = 1;
    110     yCoal = 148;
    111 
    112     // Icons.bmp structure
    113     xSizeBig = 56;
    114     ySizeBig = 40;
    115 
    116     GlowRange = 8;
    117 
    118     EmptySpaceColor = $101010;
    119 
    120     // template positions in System2.bmp
    121     xOrna = 156;
    122     yOrna = 1;
    123     wOrna = 27;
    124     hOrna = 26; // ornament
    125 
    126     // sound modes
    127     smOff = 0;
    128     smOn = 1;
    129     smOnAlt = 2;
    130 
    131     // color matrix
    132     clkAge0 = 1;
    133     cliTexture = 0;
    134     cliBevelLight = cliTexture + 1;
    135     cliBevelShade = cliTexture + 2;
    136     cliTextLight = cliTexture + 3;
    137     cliTextShade = cliTexture + 4;
    138     cliLitText = cliTexture + 5;
    139     cliMark = cliTexture + 6;
    140     cliDimmedText = cliTexture + 7;
    141     cliRoad = 8;
    142     cliHouse = cliRoad + 1;
    143     cliImp = cliRoad + 2;
    144     cliImpProject = cliRoad + 3;
    145     cliPage = 13;
    146     cliCover = cliPage + 1;
    147     clkMisc = 5;
    148     cliPaper = 0;
    149     cliPaperText = 1;
    150     cliPaperCaption = 2;
    151     clkCity = 6;
    152     cliPlains = 0;
    153     cliPrairie = 1;
    154     cliHills = 2;
    155     cliTundra = 3;
    156     cliWater = 4;
    157 
    158     // LoadGraphicFile options
    159     gfNoError = $01;
    160     gfNoGamma = $02;
    161     gfJPG = $04;
    162 
    163   type
    164     TGrExtDescr = record { don't use dynamic strings here! }
    165       Name: string[31];
    166       Data, Mask: TBitmap;
    167       pixUsed: array [Byte] of Byte;
    168     end;
    169 
    170     TGrExtDescrSize = record { for size calculation only - must be the same as
    171         TGrExtDescr, but without pixUsed }
    172       Name: string[31];
    173       Data, Mask: TBitmap;
    174     end;
    175 
    176     TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton);
    177 
    178   var
    179     Phrases, Phrases2, Sounds: TStringTable;
    180     nGrExt: integer;
    181     GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr;
    182     HGrSystem, HGrSystem2, ClickFrameColor, SoundMode, MainTextureAge: integer;
    183     MainTexture: TTexture;
    184     Templates, Colors, Paper, BigImp, LogoBuffer: TBitmap;
    185     FullScreen, GenerateNames, InitOrnamentDone,
    186       Phrases2FallenBackToEnglish: boolean;
    187 
    188     UniFont: array [TFontType] of TFont;
     19function ChangeResolution(x, y, bpp, freq: integer): boolean;
     20procedure RestoreResolution;
     21function Play(Item: string; Index: integer = -1): boolean;
     22procedure PreparePlay(Item: string; Index: integer = -1);
     23procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0);
     24function turntoyear(Turn: integer): integer;
     25function TurnToString(Turn: integer): string;
     26function MovementToString(Movement: integer): string;
     27procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
     28procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
     29function HexStringToColor(s: string): integer;
     30function LoadGraphicFile(bmp: TBitmap; Path: string;
     31  Options: integer = 0): boolean;
     32function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string;
     33  Options: integer = 0): boolean;
     34function LoadGraphicSet(Name: string): integer;
     35procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     36procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr,
     37  yGr: integer); overload;
     38procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr,
     39  yGr: integer); overload;
     40procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
     41procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);
     42procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h, Color1,
     43  Color2: integer);
     44procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1,
     45  Color2: integer);
     46procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
     47procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
     48procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     49procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     50procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
     51procedure FrameImage(ca: TCanvas; Src: TBitmap;
     52  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = false);
     53procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);
     54procedure InitOrnament;
     55procedure InitCityMark(const T: TTexture);
     56procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset,
     57  yOffset: integer);
     58procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
     59procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset,
     60  yOffset: integer; const Texture: TBitmap);
     61procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset,
     62  yOffset: integer; const Texture: TBitmap);
     63procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
     64procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture);
     65procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer;
     66  s: string);
     67procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
     68  x, y: integer; s: string);
     69function BiColorTextWidth(ca: TCanvas; s: string): integer;
     70procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
     71procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
     72procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
     73procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
     74procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
     75procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;
     76  const T: TTexture);
     77procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer; Cap: string;
     78  val: integer; const T: TTexture);
     79procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: integer;
     80  const T: TTexture);
     81procedure PaintRelativeProgressBar(ca: TCanvas; Kind, x, y, size, pos, Growth,
     82  max: integer; IndicateComplete: boolean; const T: TTexture);
     83procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
     84function SetMainTextureByAge(Age: integer): boolean;
     85
     86const
     87  nGrExtmax = 64;
     88  wMainTexture = 640;
     89  hMainTexture = 480;
     90
     91  // template positions in Template.bmp
     92  xLogo = 1;
     93  yLogo = 1;
     94  wLogo = 122;
     95  hLogo = 23; // logo
     96  xBBook = 1;
     97  yBBook = 74;
     98  wBBook = 143;
     99  hBBook = 73; // big book
     100  xSBook = 72;
     101  ySBook = 37;
     102  wSBook = 72;
     103  hSBook = 36; // small book
     104  xNation = 1;
     105  yNation = 25;
     106  xCoal = 1;
     107  yCoal = 148;
     108
     109  // Icons.bmp structure
     110  xSizeBig = 56;
     111  ySizeBig = 40;
     112
     113  GlowRange = 8;
     114
     115  EmptySpaceColor = $101010;
     116
     117  // template positions in System2.bmp
     118  xOrna = 156;
     119  yOrna = 1;
     120  wOrna = 27;
     121  hOrna = 26; // ornament
     122
     123  // sound modes
     124  smOff = 0;
     125  smOn = 1;
     126  smOnAlt = 2;
     127
     128  // color matrix
     129  clkAge0 = 1;
     130  cliTexture = 0;
     131  cliBevelLight = cliTexture + 1;
     132  cliBevelShade = cliTexture + 2;
     133  cliTextLight = cliTexture + 3;
     134  cliTextShade = cliTexture + 4;
     135  cliLitText = cliTexture + 5;
     136  cliMark = cliTexture + 6;
     137  cliDimmedText = cliTexture + 7;
     138  cliRoad = 8;
     139  cliHouse = cliRoad + 1;
     140  cliImp = cliRoad + 2;
     141  cliImpProject = cliRoad + 3;
     142  cliPage = 13;
     143  cliCover = cliPage + 1;
     144  clkMisc = 5;
     145  cliPaper = 0;
     146  cliPaperText = 1;
     147  cliPaperCaption = 2;
     148  clkCity = 6;
     149  cliPlains = 0;
     150  cliPrairie = 1;
     151  cliHills = 2;
     152  cliTundra = 3;
     153  cliWater = 4;
     154
     155  // LoadGraphicFile options
     156  gfNoError = $01;
     157  gfNoGamma = $02;
     158  gfJPG = $04;
     159
     160type
     161  TGrExtDescr = record { don't use dynamic strings here! }
     162    Name: string[31];
     163    Data, Mask: TBitmap;
     164    pixUsed: array [Byte] of Byte;
     165  end;
     166
     167  TGrExtDescrSize = record { for size calculation only - must be the same as
     168      TGrExtDescr, but without pixUsed }
     169    Name: string[31];
     170    Data, Mask: TBitmap;
     171  end;
     172
     173  TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton);
     174
     175var
     176  Phrases, Phrases2, Sounds: TStringTable;
     177  nGrExt: integer;
     178  GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr;
     179  HGrSystem, HGrSystem2, ClickFrameColor, SoundMode, MainTextureAge: integer;
     180  MainTexture: TTexture;
     181  Templates, Colors, Paper, BigImp, LogoBuffer: TBitmap;
     182  FullScreen, GenerateNames, InitOrnamentDone,
     183    Phrases2FallenBackToEnglish: boolean;
     184
     185  UniFont: array [TFontType] of TFont;
    189186
    190187implementation
    … …  
    14571454
    14581455Reg := TRegistry.create;
    1459 Reg.OpenKey('SOFTWARE\cevo\RegVer9', true);
    14601456try
    1461   Gamma := Reg.ReadInteger('Gamma');
    1462 except
    1463   Gamma := 100;
    1464   Reg.WriteInteger('Gamma', Gamma);
    1465 end;
    1466 Reg.closekey;
    1467 Reg.Free;
     1457  Reg.OpenKey('SOFTWARE\cevo\RegVer9', true);
     1458  if Reg.ValueExists('Gamma') then
     1459    Gamma := Reg.ReadInteger('Gamma')
     1460    else begin
     1461      Gamma := 100;
     1462      Reg.WriteInteger('Gamma', Gamma);
     1463    end;
     1464finally
     1465  Reg.Free;
     1466end;
    14681467
    14691468if Gamma <> 100 then

  • trunk/Start.pas

    r12 r14  
    207207    Reg.WriteInteger('MultiControl', 0);
    208208    Reg.closekey;
    209 
    210     // register file type: "cevo Book" -- fails with no administrator rights!
    211     try
    212       Reg.RootKey := HKEY_CLASSES_ROOT;
    213       Reg.OpenKey('.cevo', true);
    214       Reg.WriteString('', 'cevoBook');
    215       Reg.closekey;
    216       Reg.OpenKey('cevoBook', true);
    217       Reg.WriteString('', 'cevo Book');
    218       Reg.closekey;
    219       Reg.OpenKey('cevoBook\DefaultIcon', true);
    220       Reg.WriteString('', ParamStr(0) + ',0');
    221       Reg.closekey;
    222       Reg.OpenKey('cevoBook\shell\open\command', true);
    223       Reg.WriteString('', ParamStr(0) + ' "%1"');
    224       Reg.closekey;
    225     except
    226     end;
    227209  end
    228210  else
Note: See TracChangeset for help on using the changeset viewer.